library(quanteda)
library(quanteda.textplots)
library(stringr)
setwd("C:\\Users\\Recesvinto\\Documents\\ANO 3º\\Busqueda_Informacion\\TRABAJO\\")
ficheros_csv <- list.files(path="tweets\\", pattern="*.csv")
data_frame_troll <- data.frame()
for (i in ficheros_csv){
lectura <- read.csv(paste0("tweets/",i),header = TRUE,sep = ",")
print(nrow(lectura))
data_frame_troll <- rbind(lectura,data_frame_troll)
}
print(nrow(data_frame_troll))
names(data_frame_troll)
##QUITAMOS COLUMNAS
df_trolls <- subset(data_frame_troll, select = c("author", "content","region","language","publish_date","post_type","account_type","account_category"))
#FACTORIZAMOS
df_trolls$region <- as.factor(df_trolls$region)
df_trolls$language <- as.factor(df_trolls$language)
df_trolls$post_type <- as.factor(df_trolls$post_type)
df_trolls$account_type <- as.factor(df_trolls$account_type)
df_trolls$account_category <- as.factor(df_trolls$account_category)
summary(df_trolls)
#Fechas
df_trolls$publish_date <- as.Date(df_trolls$publish_date,format = "%m/%d/%Y")
# Nos quedamos solo con los tweats que estan en ingles
datos_filtrados <- subset(df_trolls, language == "English")
save(datos_filtrados,file = "datos_filtrados.rda")
#Vamos a limpiar el dataset de caracteres raros
datos_filtrados$content <- str_replace_all(datos_filtrados$content,
pattern = "https?://([^/\\s]++)\\S*+|http?://([^/\\s]++)\\S*+",
replacement = "")
#Limipiamos el dataset de links,@..
datos_filtrados$content <- gsub("(#\\w+)|(http\\S+)|(https\\S+)|(&)|(@\\w+)|(RT)", "", datos_filtrados$content)
# Hacemos lowercase
datos_filtrados$content <- tolower(datos_filtrados$content)
# Limpiamos emojis y characteres raros
datos_filtrados$content <- gsub("[\\x{1F600}-\\x{1F6FF}|\\x{2600}-\\x{26FF}|\\x{2700}-\\x{27BF}|\\x{1F300}-\\x{1F5FF}|\\x{1F680}-\\x{1F6FF}|\\x{1F1E0}-\\x{1F1FF}|\\x{1F900}-\\x{1F9FF}|\\x{1F7E0}-\\x{1F7FF}|\\x{1F918}]", "", datos_filtrados$content, perl=TRUE)
datos_filtrados$content <- gsub("[^[:alnum:][:space:]]", "", datos_filtrados$content, perl=TRUE)
#Buscamos si ha quedado relativamente limpio
grep(pattern = "http",datos_filtrados$content,perl = T)
grep(pattern = "#",datos_filtrados$content,perl = T)
#Salvamos el objeto
save(datos_filtrados,file = "datos_filtrados.rda")
# Temas "raros" (pelo, perder peso...)
indices <- grep("hair loss",datos_filtrados$content)
# Tomar los primeros X índices encontrados
primeros_X <- head(indices, 50)
hair loss
#Lo primero que tenemos que hacer es quitar las palabras que sean simialer a hair pero que no tengan nada que ver
# Para poder estudiar lo mejor posible el texto
# Definir las palabras que queremos eliminar
palabras_eliminar <- c("chair", "gopchairwoman","chairman","chairwoman","hairim","hairdresser","wheelchair","chairmnoomowmow","spectorhairday","conniehair","gopchairwoman","kayhair1","chairwho","strathairn","hairraising","hairband")
# Función para eliminar las palabras
eliminar_palabras <- function(texto, palabras) {
texto_limpio <- gsub(paste(palabras, collapse = "|"), "", texto)
return(texto_limpio)
}
# Aplicar la función a la columna texto del dataset
datos_filtrados$content <- sapply(datos_filtrados$content, eliminar_palabras, palabras = palabras_eliminar)
#Ahora vamos a coger la muestra que solo hable de los temas relacionados con el "hair"
datos_filtrados <- subset(datos_filtrados, grepl("hair", datos_filtrados$content))
#Salvamos el Objeto
save(datos_filtrados,file = "datos_filtrados_hair.rda")
# RigthTroll
# Nos quedamos solo con los tweats de RigthTroll
ds_right_hair <- subset(datos_filtrados, account_category == "RightTroll")
save(ds_right_hair,file = "ds_right_hair.rda")
#CREAMOS UN CORPUS
#Un corpus es como un dataframe codificado, lo necesitamos codificado para llamar a funciones de alto nivel matematicas
#Necesitamos funciones matematicas para mineria de texto
corpus_right_hair <- quanteda::corpus(ds_right_hair$content)
docvars(corpus_right_hair, "account_category") <- ds_right_hair$account_category
docvars(corpus_right_hair, "account_type") <- ds_right_hair$account_type
docvars(corpus_right_hair, "lengua") <- ds_right_hair$language
docvars(corpus_right_hair,"fecha") <- ds_right_hair$publish_date
docvars(corpus_right_hair,"autor") <- ds_right_hair$author
docvars(corpus_right_hair,"region") <- ds_right_hair$region
docvars(corpus_right_hair,"post_type") <- ds_right_hair$post_type
summary(corpus_right_hair)
#Asignamos tokens (elemento suele ser una palabra)
trolls_corpus_right_hair <- tokens(corpus_right_hair)
#kwic busca todos los mensajes relacionados con el token hair
hair_tweets <- kwic(trolls_corpus_right_hair,"hair")
View(hair_tweets)
#Vamos a limpiar nuestro corpus de : numeros, simbolos,url...
tok_tweets <-quanteda::tokens(corpus_right_hair,
what = "word",
remove_numbers = TRUE,
remove_punct = TRUE,
remove_symbols = TRUE,
remove_separators = TRUE,
remove_url = TRUE)
# tokens_select hace un filtrado tanto para buscar como para eliminar
#*Queremos quitar las stopwords del Ingles como : preposiciones o i´ve,when only..
#*
tok_tweets <-tokens_select(tok_tweets,
pattern = stopwords("en"),
selection = "remove")
#Hacemos matrices de frecuencia que contienen tokens y su aparicion en el dataset
myStemMat <-dfm(tok_tweets)
#Mostramos las palabras que mas aparecen
topfeatures(myStemMat,100)
#Hacemos un bigrama
tok_tweets_2 <- tokens_ngrams(tok_tweets,
n = 2)
#Hacemos un bigrama
myStemMat <- dfm(tok_tweets_2)
#Sacamos el 100 top words
topfeatures(myStemMat,100)
#Creamos semilla para crear una imagen
set.seed(100)
png(filename="hair_right.png",
width=3000,
height=3000)
textplot_wordcloud(myStemMat,
min_count = 10,
random_order = FALSE,
rotation = 0,
color = RColorBrewer::brewer.pal(8,"Dark2"))
#Cerramos la conexion para que se cree la imagen png
dev.off()
hair loss
# LeftTroll
load("datos_filtrados.rda")
# Nos quedamos solo con los tweats LeftTroll
ds_left_hair <- subset(datos_filtrados, account_category == "LeftTroll")
save(ds_left_hair,file = "ds_left_hair.rda")
#CREAMOS UN CORPUS
corpus_left_hair <- quanteda::corpus(ds_left_hair$content)
docvars(corpus_left_hair, "account_category") <- ds_left_hair$account_category
docvars(corpus_left_hair, "account_type") <- ds_left_hair$account_type
docvars(corpus_left_hair, "lengua") <- ds_left_hair$language
docvars(corpus_left_hair,"fecha") <- ds_left_hair$publish_date
docvars(corpus_left_hair,"autor") <- ds_left_hair$author
docvars(corpus_left_hair,"region") <- ds_left_hair$region
docvars(corpus_left_hair,"post_type") <- ds_left_hair$post_type
summary(corpus_left_hair)
#******Asignamos tokens (elemento suele ser una palabra)
trolls_corpus_left_hair <- tokens(corpus_left_hair)
#******kwic busca todos los mensajes relacionados con el token hair
hair_tweets <- kwic(trolls_corpus_left_hair,"hair")
View(hair_tweets)
#******Vamos a limpiar nuestro corpus de : numeros, simbolos,url...
tok_tweets <-quanteda::tokens(corpus_left_hair,
what = "word",
remove_numbers = TRUE,
remove_punct = TRUE,
remove_symbols = TRUE,
remove_separators = TRUE,
remove_url = TRUE)
#****** tokens_select hace un filtrado tanto para buscar como para eliminar
#*Queremos quitar las stopwords del Ingles como : preposiciones o i´ve,when only..
#*
tok_tweets <-tokens_select(tok_tweets,
pattern = stopwords("en"),
selection = "remove")
#******Hacemos matrices de frecuencia que contienen tokens y su aparicion en el dataset
myStemMat <-dfm(tok_tweets)
#******Mostramos las palabras que mas aparecen
topfeatures(myStemMat,100)
#Hacemos un bigrama
tok_tweets_2 <- tokens_ngrams(tok_tweets,
n = 2)
#Hacemos un bigrama
myStemMat <- dfm(tok_tweets_2)
#Sacamos el 100 top words
topfeatures(myStemMat,100)
#Creamos semilla para crear una imagen
set.seed(100)
png(filename="hair_left.png",
width=3000,
height=3000)
textplot_wordcloud(myStemMat,
min_count = 10,
random_order = FALSE,
rotation = 0,
color = RColorBrewer::brewer.pal(8,"Dark2"))
#Cerramos la conexion para que se cree la imagen png
dev.off()
hair loss
library(tidytext)
library(tidyverse)
library(syuzhet)
library(dplyr)
library(textdata)
library(ggplot2)
#install.packages("syuzhet")
#install.packages("textdata")
### Analisis de Sentimientos
load("ds_right_hair.rda")
#Añadimos una columna que tenga un id
ds_right_hair <- ds_right_hair %>%
mutate(tweet_id = row_number())
blonde <- ds_right_hair
# Dividir los tweets en palabras y crear un tidy dataset
ds_tweets_tidy <- blonde %>%
unnest_tokens(word, content)
#Aplicamos un Analisis de sentimiento a esos Tweets
#En este caso vamos hacer un Inner Join del contenido de los tweets y añadirle el resultado del analis de sentimiento
tweets_sentiment <- ds_tweets_tidy %>%
inner_join(get_sentiments("afinn"), by = "word") %>%
inner_join(blonde %>% select(tweet_id, content), by = "tweet_id") %>%
group_by(doc_id = tweet_id) %>%
summarise(sentiment = sum(value), text = first(content))
#Mostramos los resultados
tweets_sentiment %>%
arrange(desc(sentiment))
| doc_id | sentiment | text |
|---|---|---|
| 1 | 3 | you just slim jesus w hair |
| 1104 | 1 | yes their hair is so full of life |
| .. | .. | .. |
# Crear el gráfico de puntos
ggplot(data = tweets_sentiment, aes(x = sentiment)) +
geom_bar(color = 'darkslategray', fill = 'steelblue') +
xlab("Sentimiento") +
ylab("Cantidad de Tweets") +
ggtitle("Gráfico de Barras")
hair loss
hair loss
hair loss
(Maryanne Trump Barry) Hubo unas polémicas con ciertas grabaciones que se filtraron donde su propia hermana hablaba muy mal de Donald Trump haciendo graves acusaciones sobre él .
Comentarios apoyando Trump y su pelo y criticando a Bill o’reilly (Presentador de TV)
Comentarios sobre el show de Jimmy Fallon(Presentador de TV) y cuando agito su pelo
Tweats genéricos acerca del cuidado del pelo y beneficios para el mismo (Subrayados en verde)
…
### Analisis de Sentimientos
load("ds_left_hair.rda")
#Añadimos una columna que tenga un id
ds_left_hair <- ds_left_hair %>%
mutate(tweet_id = row_number())
blonde <- ds_left_hair
# Dividir los tweets en palabras y crear un tidy dataset
ds_tweets_tidy <- blonde %>%
unnest_tokens(word, content)
#Aplicamos un Analisis de sentimiento a esos Tweets
#En este caso vamos hacer un Inner Join del contenido de los tweets y añadirle el resultado del analis de sentimiento
tweets_sentiment <- ds_tweets_tidy %>%
inner_join(get_sentiments("afinn"), by = "word") %>%
inner_join(blonde %>% select(tweet_id, content), by = "tweet_id") %>%
group_by(doc_id = tweet_id) %>%
summarise(sentiment = sum(value), text = first(content))
#Mostramos los resultados
tweets_sentiment %>%
arrange(desc(sentiment))
# Crear el gráfico de puntos
ggplot(data = tweets_sentiment, aes(x = sentiment)) +
geom_bar(color = 'darkslategray', fill = 'steelblue') +
xlab("Sentimiento") +
ylab("Cantidad de Tweets") +
ggtitle("Gráfico de Barras")
hair loss
hair loss
#### La muestra de tweats categorizados como
negativos hablan de los siguientes temas:
Tweats genéricos en forma de amenaza (Subrayados en verde)
Tweats racistas hacia la población blanca Estadounidense
Tweats hablando de posible violencia policial
Tweats hablando de “body positive” posiblemente femenino
Tweats hablando de como el racismo es algo que se desarrolla en la sociedad
Temas de Racismo en general …
hair loss
Tweats genéricos en forma de amenaza (Subrayados en verde)
Tweats relacionados con una cantante (Amber Rose)
Tweats apoyando los canones de belleza Afroamericana.
Tweats hablando de “body positive” posiblemente femenina Afroamericana
…
hair loss
hair loss